home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbmouse.zip / BITMAP.BAS next >
BASIC Source File  |  1993-07-06  |  8KB  |  225 lines
  1.     ' Filename: BITMAP.BAS.
  2.  
  3.     ' A bitmap editor to produce 16 x 16 bitmaps to use as graphics mouse
  4.     ' pointers, with the function MouseGraphicsPtr.  This is a very simple
  5.     ' and rather primitive bitmap editor, with no fancy stuff.  However, it
  6.     ' is certainly MUCH simpler than figuring out the bitmap integers by
  7.     ' hand, yourself. ;-)  After starting the program, wait for the the
  8.     ' mouse pointer to appear, then put it on the bit in the bitmap grid
  9.     ' on the left which you wish to change, then press one of the mouse
  10.     ' buttons, then move the pointer a few grid boxes away from that one
  11.     ' to ensure that the pointer doesn't interfere with drawing lines and
  12.     ' such.  If the bit is set (on) is will be cleared, and if it is off,
  13.     ' it will be set.  A representation of what the bitmap will actually
  14.     ' look like is shown on the right.  When you have finished drawing your
  15.     ' bitmap, put the mouse pointer on the "Save..." box and press a button.
  16.     ' You will be asked for a filename to save to (if the file exists, it
  17.     ' will append to it), and a name for the bitmap (the variable name), and
  18.     ' the type of screen mask you want (whether the pointer should be
  19.     ' see-through, or solid, or solid with an outline).  Then, it will
  20.     ' print out the necessary commands to set up the bitmap variable (of
  21.     ' type BitMap), which you can then merge or include into your code for
  22.     ' use.  A few useful pre-made bitmaps can be found in the file
  23.     ' BITMAPS.TXT, which you can merge into your code for use, as well.
  24.     ' Note: This program only creates new bitmaps, which you can then save.
  25.     ' It does not allow you to edit old, already saved, bitmaps.  This would
  26.     ' be a good feature to add, but I didn't feel like adding it.  As I said,
  27.     ' it is a primitive thing, but still better than drawing out bitmap grids
  28.     ' by hand and then converting binary to decimal or hex, yourself... ;-)
  29.  
  30.     ' I only distribute the (not too pretty) code with this program so that
  31.     ' you can see a sample of how my mouse functions can be used in a
  32.     ' program.
  33.  
  34.     ' Must include the MOUSE.BI include file...
  35.     '$INCLUDE: 'mouse.bi'
  36.  
  37.     ' Set screen mode to 2 (640 x 200 resolution, monochrome).
  38.     SCREEN 2
  39.     CLS
  40.     DIM bits(16, 16) AS INTEGER     ' 2-D array to store bitmap info
  41.     DIM event AS MouseEvent         ' A MouseEvent variable
  42.     DIM bitline AS INTEGER          ' 16 bit integer for pointer map
  43.     DIM scrline AS INTEGER          ' 16 bit integer for screen map
  44.     FOR y = 1 TO 16
  45.         FOR x = 1 TO 16
  46.             bits(x, y) = FALSE      ' Clear all bits of the bitmap
  47.         NEXT x
  48.     NEXT y
  49.     FOR y = 0 TO 75 STEP 5
  50.         FOR x = 0 TO 150 STEP 10
  51.             LINE (x, y)-(x + 10, y + 5), , B    ' Draw bitmap grid
  52.         NEXT x
  53.     NEXT y
  54.     LOCATE 20, 20
  55.     PRINT "Save..."
  56.     LOCATE 20, 60
  57.     PRINT "Quit"
  58.     LINE ((19 * 8) - 2, (19 * 8) - 2)-STEP(60, 10), , B     ' Save box
  59.     LINE ((59 * 8) - 2, (19 * 8) - 2)-STEP(40, 10), , B     ' Quit box
  60.     LOCATE 2, 55
  61.     PRINT "Sample output:"
  62.     LOCATE 25, 36
  63.     PRINT "Wait...";
  64.     IF MouseInit(2) = 0 THEN
  65.         GOTO ex                 ' Exit
  66.     END IF
  67.     LOCATE 25, 36
  68.     PRINT "       ";
  69. top:
  70.     WHILE NOT MouseButton(event, TRUE)      ' Wait for user to press button
  71.     WEND
  72.     ' If mouse is in the bitmap grid...
  73.     IF event.x >= 0 AND event.x <= 160 AND event.y >= 0 AND event.y <= 80 THEN
  74.         GOTO bitchange
  75.     ' If mouse is in the Save box...
  76.     ELSEIF event.x >= (19 * 8) - 2 AND event.x <= (19 * 8) + 58 AND event.y >= (19 * 8) - 2 AND event.y <= (19 * 8) + 8 THEN
  77.         GOTO save
  78.     ' If mouse is in the quit box...
  79.     ELSEIF event.x >= (59 * 8) - 2 AND event.x <= (59 * 8) + 38 AND event.y >= (19 * 8) - 2 AND event.y <= (19 * 8) + 8 THEN
  80.         GOTO quit
  81.     END IF
  82.     GOTO top        ' Go back and wait for another button press
  83.  
  84. bitchange:
  85.     xx = INT(event.x / 10) + 1      ' Convert position of mouse on screen to
  86.     yy = INT(event.y / 5) + 1       ' index into 2-D array of bitmap info
  87.     bits(xx, yy) = NOT bits(xx, yy)     ' Flip the bit; off -> on, on -> off
  88. waitformove:
  89.     WHILE NOT MouseMove(event)  ' Wait for user to move pointer away from the
  90.     WEND                        ' spot, so it doesn't interfere with graphics
  91.     ' If they haven't moved far enough away yet...
  92.     IF INT(event.x / 10) + 1 < xx + 2 AND INT(event.x / 10) + 1 > xx - 4 AND INT(event.y / 5) + 1 < yy + 2 AND INT(event.y / 5) + 1 > yy - 5 THEN
  93.         GOTO waitformove
  94.     END IF
  95.     IF bits(xx, yy) THEN        ' Bit is on
  96.         LINE ((xx - 1) * 10, (yy - 1) * 5)-STEP(10, 5), , BF ' Fill grid spot
  97.         PSET (xx + 500, yy + 50)            ' Set pixel on sample display
  98.     ELSE                        ' Bit is off
  99.         FOR y = (yy - 1) * 5 TO ((yy - 1) * 5) + 5
  100.             FOR x = (xx - 1) * 10 TO ((xx - 1) * 10) + 10
  101.                 PRESET (x, y)       ' Erase grid spot
  102.             NEXT x
  103.         NEXT y
  104.         LINE ((xx - 1) * 10, (yy - 1) * 5)-STEP(10, 5), , B ' Redraw grid box
  105.         PRESET (xx + 500, yy + 50)      ' Turn off pixel on sample display
  106.     END IF
  107.     GOTO top        ' Go back to wait for another button press
  108.  
  109. save:
  110.     MouseHide       ' Turn off mouse
  111.     CLS
  112.     INPUT "Enter filename to save to: ", file$
  113.     PRINT
  114.     INPUT "Enter the name of the bitmap: ", nm$
  115.     PRINT
  116.     PRINT " 0  -  See-through pointer"
  117.     PRINT " 1  -  Solid over-writing pointer"
  118.     PRINT " 2  -  Solid over-writing pointer, with outline"
  119.     PRINT
  120.     PRINT "Press the number of your choice to determine screen mask."
  121. scrin:
  122.     scrtype$ = INPUT$(1)
  123.     IF scrtype$ <> "0" AND scrtype$ <> "1" AND scrtype$ <> "2" THEN
  124.         BEEP
  125.         GOTO scrin
  126.     END IF
  127.     ON ERROR GOTO badfile       ' File error handler
  128.     OPEN file$ FOR APPEND AS #1
  129.     PRINT #1,
  130.     PRINT #1, "    DIM "; nm$; " AS BitMap"     ' Dimension command
  131.     PRINT #1,
  132.     FOR y = 1 TO 16
  133.         bitline = 0
  134.         dif = 16
  135.         FOR x = 16 TO 2 STEP -1     ' Calculate the integers
  136.             bitline = bitline + ((bits(x, y) AND 1) * (2 ^ (x - dif)))
  137.             dif = dif - 2
  138.         NEXT x
  139.         IF bits(1, y) THEN          ' High bit set in grid
  140.             bitline = bitline OR &H8000     ' set high bit of integer
  141.         END IF
  142.         IF scrtype$ = "0" THEN      ' See-through
  143.             scrline = NOT 0
  144.         ELSEIF scrtype$ = "1" THEN  ' Solid
  145.             scrline = NOT bitline
  146.         ELSE                        ' Solid with outline
  147.             scrline = NOT bitline
  148.             FOR b = 0 TO 13
  149.                 IF (scrline AND (2 ^ b)) <> 0 THEN       ' a 1 bit here
  150.                     IF (scrline AND (2 ^ (b + 1))) = 0 THEN ' Next bit is 0
  151.                         scrline = scrline AND (NOT (2 ^ b)) ' clear the bit
  152.                     END IF
  153.                 END IF
  154.             NEXT b
  155.             IF (scrline AND &H4000) <> 0 THEN        ' 1 at bit 14
  156.                 IF (scrline AND &H8000) = 0 THEN    ' 0 at bit 15
  157.                     scrline = scrline AND (NOT &H4000)  ' clear the bit
  158.                 END IF
  159.             END IF
  160.             IF (scrline AND &H8000) <> 0 THEN        ' 1 at bit 15
  161.                 IF (scrline AND &H4000) = 0 THEN    ' 0 at bit 14
  162.                     scrline = scrline AND (NOT &H8000)  ' clear the bit
  163.                 END IF
  164.             END IF
  165.             FOR b = 14 TO 1 STEP -1
  166.                 IF (scrline AND (2 ^ b)) <> 0 THEN       ' a 1 bit here
  167.                     IF (scrline AND (2 ^ (b - 1))) = 0 THEN ' prev. bit is 0
  168.                         scrline = scrline AND (NOT (2 ^ b)) ' clear the bit
  169.                     END IF
  170.                 END IF
  171.             NEXT b
  172.         END IF
  173.         ' Print out values...
  174.         PRINT #1, "    "; nm$; ".ptr"; LTRIM$(STR$(y)); " = "; STR$(bitline)
  175.         PRINT #1, "    "; nm$; ".screen"; LTRIM$(STR$(y)); " = "; STR$(scrline)
  176.     NEXT y
  177.     GOTO ex     ' Exit
  178.  
  179. quit:
  180.     LOCATE 25, 15
  181.     PRINT "Do you really want to quit without saving? [y,n]";
  182. qin:
  183.     q$ = UCASE$(INKEY$)
  184.     IF q$ = "" THEN
  185.         GOTO qin
  186.     ELSEIF q$ = "N" THEN
  187.         LOCATE 25, 13
  188.         PRINT SPACE$(54);
  189.         GOTO top
  190.     ELSEIF q$ = "Y" THEN
  191.         MouseHide
  192.         GOTO ex
  193.     ELSE
  194.         BEEP
  195.         GOTO qin
  196.     END IF
  197.  
  198. ex:
  199.     SCREEN 0
  200.     CLS
  201.     PRINT "Goodbye..."
  202.     PRINT
  203.     END
  204.  
  205. badfile:
  206.     IF ERR = 52 OR ERR = 53 OR ERR = 54 OR ERR = 55 OR ERR = 58 OR ERR = 64 OR ERR = 70 OR ERR = 75 OR ERR = 76 THEN
  207.         PRINT
  208.         PRINT "Bad file name!"
  209.         PRINT
  210.         INPUT "Reenter file name: ", file$
  211.         RESUME
  212.     ELSEIF ERR = 57 OR ERR = 61 OR ERR = 67 OR ERR = 68 OR ERR = 71 OR ERR = 72 THEN
  213.         PRINT
  214.         PRINT "Disk error (full, not ready, etc.)"
  215.         PRINT
  216.         PRINT "Press any key to continue if problem is corrected."
  217.         WHILE INKEY$ = ""
  218.         WEND
  219.         RESUME
  220.     ELSE
  221.         ON ERROR GOTO 0
  222.         END
  223.     END IF
  224.  
  225.